Magnum One

home *** CD-ROM | disk | FTP | other *** search

/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d5 / yahtzee.arc / YAHTZEE.BAS (.txt) < prev

Wrap

GW-BASIC | 1985-11-10 | 14.8 KB | 613 lines

1000 ' YATZEE 1010 ' ORIGINAL BY JL HELMS & MF PEZOK FOR CCII 1020 ' CORONADO, CA 1030 ' ADAPTED TO IBM PC BY PATRICK LEABO 1040 ' TUCSON, AZ 1050 ' 1060 DEFINT A-Z 1070 DIM C(5):DIM K(18,7):DIM F(5):DIM A$(7) 1080 DIM S(6,5):DIM M(13),TN(6),DU(6):KEY OFF:COLOR 7,0:WIDTH 80 1090 SCREEN 0,1:RESTORE 1150:FOR N= 1 TO 6:READ TN(N):NEXT 1100 COMMON MENU 1110 GOSUB 5090 1120 C1= 39:C2= 63:C3= 33:C4= 56 1130 GOSUB 4660 1140 CLS:GOSUB 4430 1150 DATA 49,51,53,54,56,61 1160 GOSUB 6820:REM draw yatzee board 1170 RANDOMIZE VAL(RIGHT$(TIME$,2)) 1180 LOCATE 25,1 1190 PRINT "HOW MANY PLAYERS? ";:LOCATE ,,1:GOSUB 2090 1200 GOSUB 7100: N=ASC(KB$)-48 1210 IF N< 1 OR N> 5 THEN 1180 1220 IF N< 5 THEN GOSUB 6000 1230 IF CC= 1THEN GOSUB 5480 1240 FOR A= 1TO N 1250 LOCATE 25,1:PRINTSTRING$(70," ");:LOCATE 25,1 1260 PRINT "PLAYER NUMBER "A;" NAME PLEASE "; 1270 GOSUB 2090:LINE INPUT ;A$(A):IF A$(A)= "" THEN BEEP:GOTO 1250 1280 A$(A)=LEFT$(A$(A),9) 1290 NEXT A 1300 IF CC= 1 THEN N= N+ 1:A$(N)= "IBM PC" 1310 LOCATE 23,1 1320 A= 0 1330 REM 1340 REM NEXT ROLL PRESET 1350 REM 1360 A= A+ 1:IF A> N THEN A= 1 1370 H= 0:GOSUB 5340 1380 IF A= 0THEN 4760 1390 IF K(18,A)= 2THEN 1360 1400 LOCATE 23,1:PRINT STRING$(60," "); 1410 LOCATE 23,4* (A- 1)+ 14 1420 PRINT A$(A); 1430 REM 1440 REM INITIAL ROLL 1450 REM 1460 H= H+ 1:MR= 0 1470 FOR B= 1TO 5 1480 J= B- 1:C(B)= INT (6* RND (1)+ 1) 1490 DIE= C(B):F(B)= 0 1500 GOSUB 5250 1510 GOSUB 5530 1520 NEXT B 1530 IF A* CC= N THEN 2140 1540 REM 1550 REM PLAYER SELECTS QTY TO ROLL 1560 REM 1570 GOSUB 7080 1580 IF H> 2THEN 1940 1590 POKE 106,0:PRINT " HOW MANY DICE TO ROLL AGAIN? ";:LOCATE ,,1:GOSUB 2080:GOSUB 7100:F$=KB$:PRINT F$;:F=ASC(F$)-48:LOCATE ,,0 1600 IF F= - 1THEN GOSUB 35000 1610 IF F< 0OR F> 5THEN 1570 1620 IF F= 0THEN 1940 1630 IF F= 5THEN 1430 1640 REM 1650 REM PLAYER SELECTS DICE TO ROLL 1660 REM 1670 H= H+ 1 1680 GOSUB 7080 1690 FOR NN= 1TO 4:F(NN)= 0:NEXT 1700 PRINT " ROLL WHICH";F;"DICE AGAIN ";:LOCATE ,,1 1710 GOSUB 2090:FOR ND= 1TO F: 1720 GOSUB 7100:F$=KB$::F(ND)= ASC(F$)- 48:GOSUB 2120:IF F(ND)= 0 AND ND= 1 THEN ND= F:GOTO 1740 1730 IF F(ND)< 1 OR F(ND)> 5 THEN 1720 1740 PRINT F(ND);:NEXT 1750 X= 2:XF= 0 1760 FOR J= 1TO F 1770 IF F= 1THEN 1790 1780 IF F(J)= F(J+ 1)THEN X= 1 1790 IF F(1)= 0THEN XF= 1 1800 NEXT J:IF XF= 1THEN H= H- 1:GOTO 1570 1810 ON X GOTO 1680,1820 1820 REM 1830 REM PLAYER ROLLS DICE AGAIN 1840 REM 1850 FOR B= 1TO 4 1860 IF F(B)= 0THEN 1920 1870 C(F(B))= INT (6* RND (1)+ 1) 1880 DIE= C(F(B)):J= F(B)- 1 1890 GOSUB 5250 1900 GOSUB 5530 1910 F(B)= 0 1920 NEXT B 1930 GOTO 1540 1940 REM 1950 REM PLAY BOARD NUMBER 1960 REM 1970 GOSUB 7080 1980 PRINT " PLAY BOARD NUMBER? ";:LOCATE ,,1:GOSUB 2080:GOSUB 7100:I$=KB$:I=ASC(I$)- 48:LOCATE ,,0:IF I> 9 THEN I= I- 7 1990 GOSUB 2120:IF I> 9 THEN PRINT CHR$ (I+ 55);:GOTO 2010 2000 PRINT I; 2010 IF I< 1OR I> 13THEN 1970 2020 IF I= 12AND K(12,A)> - 1THEN 2140 2030 IF K(I,A)= 0THEN 2140 2040 LOCATE 24,1:BEEP 2050 PRINT "NO - NO - DUMMY - - TRY AGAIN";:FOR ND=1 TO 1500:NEXT:LOCATE 24,1:PRINT STRING$(60," "); 2060 LOCATE 25,1:PRINTSTRING$(60," ");:LOCATE 25,1 2070 GOTO 1980 2080 REM HIGH PITCH CLICK 2090 PLAY "L64T200N70":RETURN 2100 REM GLISSANDO SOUND 2110 PLAY "MBt255MLL64O5CC#DD#EFF#GG#AA#B":RETURN 2120 ' LO PITCH CLICK 2130 PLAY "L64T200N46":RETURN 2140 REM 2150 REM DICE LOGIC 2160 REM CLEAR/SET S(M,K) 2170 REM 2180 FOR M= 0TO 6 2190 FOR K= 0TO 5 2200 S(M,K)= 0 2210 NEXT K 2220 NEXT M 2230 FOR J= 1TO 5 2240 X= C(J):S(X,0)= S(X,0)+ 1 2250 P= S(X,0):S(X,P)= J 2260 NEXT J 2270 REM 2280 REM SET S(0,K)=M SEQUENCE BY QTY 2290 REM 2300 X= 0 2310 FOR J= 5TO 1STEP - 1 2320 FOR M= 6TO 1STEP - 1 2330 IF S(M,0)< > J THEN 2350 2340 S(0,X)= M:X= X+ 1 2350 NEXT M 2360 NEXT J 2370 IF A* CC= N THEN 2740 2380 IF I> 6THEN 2460 2390 REM 2400 REM CHECK PLAYER BOARD 1-6 2410 REM 2420 GOSUB 6110 2430 IF X= - 1THEN 2720 2440 K(I,A)= I* S(S(0,X),0) 2450 GOTO 3980 2460 REM 2470 REM CHECK PLAYER BOARD 7-13 2480 REM 2490 ON I- 6GOTO 2500,2520,2540,2560,2610,2650,2680 2500 IF S(S(0,0),0)< 3THEN 2720 2510 GOSUB 6190:GOTO 3980 2520 IF S(S(0,0),0)< 4THEN 2720 2530 GOSUB 6190:GOTO 3980 2540 IF S(S(0,0),0)< > 3OR S(S(0,1),0)< > 2THEN 2720 2550 K(9,A)= 25:GOTO 3980 2560 IF S(1,0)> 0AND S(2,0)> 0AND S(3,0)> 0AND S(4,0)> 0THEN 2600 2570 IF S(2,0)> 0AND S(3,0)> 0AND S(4,0)> 0AND S(5,0)> 0THEN 2600 2580 IF S(3,0)> 0AND S(4,0)> 0AND S(5,0)> 0AND S(6,0)> 0THEN 2600 2590 GOTO 2720 2600 K(10,A)= 30:GOTO 3980 2610 IF S(1,0)AND S(2,0)AND S(3,0)AND S(4,0)AND S(5,0)= 1THEN 2640 2620 IF S(2,0)AND S(3,0)AND S(4,0)AND S(5,0)AND S(6,0)= 1THEN 2640 2630 GOTO 2720 2640 K(11,A)= 40:GOTO 3980 2650 IF S(S(0,0),0)< > 5THEN 2720 2660 IF K(12,A)= 0THEN K(12,A)= 50:GOTO 3980 2670 K(12,A)= K(12,A)+ 100:GOTO 3980 2680 GOSUB 6190:GOTO 3980 2690 REM 2700 REM SET PLAYER INVALID 2710 REM 2720 K(I,A)= - 1 2730 GOTO 3980 2740 REM 2750 REM COMPUTER CHECKS 2760 REM 2770 I= 12 2780 IF S(S(0,0),0)= 5AND K(12,A)= 0THEN K(12,A)= 50:GOTO 3980 2790 IF S(S(0,0),0)= 5AND K(12,A)> 0THEN K(12,A)= K(12,A)+ 100:GOTO 3980 2800 I= 8 2810 IF S(S(0,0),0)= 4AND K(8,A)= 0THEN GOSUB 6190:GOTO 3980 2820 I= 9 2830 IF S(S(0,0),0)= 3AND S(S(0,1),0)= 2AND K(9,A)= 0THEN K(9,A)= 25:GOTO 3980 2840 IF K(11,A)< > 0THEN 2900 2850 I= 11 2860 IF S(1,0)AND S(2,0)AND S(3,0)AND S(4,0)AND S(5,0)= 1THEN 2890 2870 IF S(2,0)AND S(3,0)AND S(4,0)AND S(5,0)AND S(6,0)= 1THEN 2890 2880 GOTO 2900 2890 K(11,A)= 40:GOTO 3980 2900 IF K(10,A)< > 0THEN 2970 2910 I= 10 2920 IF S(1,0)> 0AND S(2,0)> 0AND S(3,0)> 0AND S(4,0)> 0THEN 2960 2930 IF S(2,0)> 0AND S(3,0)> 0AND S(4,0)> 0AND S(5,0)> 0THEN 2960 2940 IF S(3,0)> 0AND S(4,0)> 0AND S(5,0)> 0AND S(6,0)> 0THEN 2960 2950 GOTO 2970 2960 K(10,A)= 30:GOTO 3980 2970 IF H< 3THEN 3140 2980 I= 6 2990 IF S(6,0)> 2AND K(6,A)= 0THEN K(6,A)= 6* S(6,0):GOTO 3980 3000 I= 5 3010 IF S(5,0)> 2AND K(5,A)= 0THEN K(5,A)= 5* S(5,0):GOTO 3980 3020 I= 4 3030 IF S(4,0)> 2AND K(4,A)= 0THEN K(4,A)= 4* S(4,0):GOTO 3980 3040 I= 3 3050 IF S(3,0)> 2AND K(3,A)= 0THEN K(3,A)= 3* S(3,0):GOTO 3980 3060 I= 7 3070 IF S(S(0,0),0)> 2AND K(7,A)= 0THEN GOSUB 6190:GOTO 3980 3080 I= 2 3090 IF S(2,0)> 2AND K(2,A)= 0THEN K(2,A)= 2* S(2,0):GOTO 3980 3100 I= 1 3110 IF S(1,0)> 2AND K(1,A)= 0THEN K(1,A)= S(1,0):GOTO 3980 3120 I= 13:IF K(13,A)< > 0THEN 3140 3130 IF C(1)+ C(2)+ C(3)+ C(4)+ C(5)> 19THEN GOSUB 6190:GOTO 3980 3140 REM 3150 REM CLEAR DICE NUMBER F(B) 3160 REM COMPUTER 3170 REM 3180 FOR B= 1TO 5 3190 F(B)= 0 3200 NEXT B 3210 REM 3220 REM GET DICE CONTROL 3230 REM COMPUTER 3240 REM 3250 H= H+ 1:IF H> 3THEN 3840 3260 I= M(MR):IF I< > 0THEN 3290 3270 MR= MR+ 1:IF MR> 13THEN MR= 1 3280 GOTO 3260 3290 IF I= 12AND K(12,A)> - 1THEN 3330 3300 IF K(I,A)< > 0THEN 3270 3310 IF I= 9THEN 3440 3320 IF I= 10OR I= 11THEN 3560 3330 REM 3340 REM GET DICE 1,2,3,4 3350 REM COMPUTER 3360 REM 3370 M= 0:J= 1 3380 M= M+ 1:IF M> 4THEN 3720 3390 K= S(0,M):IF K= 0THEN 3720 3400 FOR L= 1TO S(K,0) 3410 F(J)= S(K,L):J= J+ 1 3420 NEXT L 3430 GOTO 3380 3440 REM 3450 REM GET DICE FH 3460 REM COMPUTER 3470 REM 3480 M= 0:J= 1 3490 M= M+ 1:IF M> 4THEN 3720 3500 K= S(0,M):IF K= 0THEN 3720 3510 IF K> 1THEN 3490 3520 FOR L= 1TO S(K,0) 3530 F(J)= S(K,L):J= J+ 1 3540 NEXT L 3550 GOTO 3490 3560 REM 3570 REM GET DICE LG/SM ST 3580 REM COMPUTER 3590 REM 3600 M= 0:J= 1 3610 M= M+ 1:IF M> 4THEN 3680 3620 K= S(0,M):IF K= 0THEN 3680 3630 IF S(K,0)= 1THEN 3610 3640 FOR L= 1TO S(K,0) 3650 F(J)= S(K,L):J= J+ 1 3660 NEXT L 3670 GOTO 3610 3680 IF F(1)< > 0THEN 3720 3690 L= INT (2* RND (1)+ 1) 3700 F(1)= 5 3710 IF L= 1THEN F(1)= 1 3720 REM 3730 REM COMPUTER ROLL AGAIN 3740 REM 3750 FOR B= 1TO 4 3760 IF F(B)< 1THEN 3810 3770 C(F(B))= INT (6* RND (1)+ 1) 3780 DIE= C(F(B)):J= F(B)- 1 3790 GOSUB 5250 3800 GOSUB 5530 3810 F(B)= 0 3820 NEXT B 3830 GOTO 2140 3840 REM 3850 REM COMPUTER MUST SCORE 3860 REM 3870 MR= MR+ 1:IF MR> 13THEN MR= 1 3880 I= M(MR):IF I= 0THEN 3870 3890 IF K(I,A)< > 0THEN 3870 3900 IF I> 6THEN 3960 3910 GOSUB 6110 3920 IF X= - 1THEN 3970 3930 IF K(I,A)< > 0THEN 3870 3940 K(I,A)= S(I,0)* I 3950 IF K(I,A)< > 0THEN 3980 3960 IF I= 13AND K(13,A)= 0THEN GOSUB 6190 3970 IF K(I,A)= 0THEN K(I,A)= - 1 3980 REM 3990 REM GET SCOREBOARD TOTALS 4000 REM 4010 FOR J= 14TO 17 4020 K(J,A)= 0 4030 NEXT J 4040 FOR J= 1TO 6 4050 IF K(J,A)< 0THEN 4070 4060 K(15,A)= K(15,A)+ K(J,A) 4070 NEXT J 4080 IF K(15,A)> 62THEN K(14,A)= 35 4090 FOR J= 7TO 13 4100 IF K(J,A)< 0THEN 4120 4110 K(16,A)= K(16,A)+ K(J,A) 4120 NEXT J 4130 K(17,A)= K(14,A)+ K(15,A)+ K(16,A) 4140 REM 4150 REM PRINT SCORE 4160 REM 4170 GOSUB 2110 4180 COLOR 15,0 4190 FOR J= 1TO 6 4200 IF K(J,A)< 0 THEN LOCATE J+1,4* (A- 1)+ 15:PRINT " 0";:GOTO 4230 4210 IF K(J,A)< 1 THEN 4230 4220 LOCATE J+1,4* (A- 1)+ 15:PRINT USING"###";K(J,A); 4230 NEXT J 4240 FOR J= 7TO 13 4250 IF K(J,A)< 0 THEN LOCATE J+4,4* (A- 1)+ 15:PRINT " 0":GOTO 4280 4260 IF K(J,A)< 1 THEN 4280 4270 LOCATE J+4,4* (A- 1)+ 15:PRINT USING "###";K(J,A) 4280 NEXT J 4290 LOCATE 9,4* (A- 1)+ 15:PRINT USING "###";K(15,A) 4300 LOCATE 19,4* (A- 1)+ 15:PRINT USING "###";K(16,A) 4310 LOCATE 20,4* (A- 1)+ 15:PRINT USING "###";K(14,A) 4320 LOCATE 21,4* (A- 1)+ 15:PRINT USING "###";K(17,A) 4330 COLOR 7,0 4340 IF A* CC< > N THEN 1330 4350 REM 4360 REM RESET M(I) COMPUTER PRIORITIES 4370 REM 4380 FOR B= 1TO 13 4390 IF M(B)= 12THEN 4410 4400 IF M(B)= I THEN M(B)= 0 4410 NEXT B 4420 GOTO 1330 4430 REM 4440 REM INSTRUCTIONS 4450 REM 4460 PRINT " Y A H T Z E E " 4470 PRINT "THIS IS THE GAME OF YAHTZEE - " 4480 PRINT "FROM 1 TO 7 PLAYERS MAY PLAY AT THE SAME TIME" 4490 PRINT "WITH EACH PLAYERS CURRENT STATUS SHOWN ON THE" 4500 PRINT "PLAYING BOARD, INCLUDING TOTAL SCORES" 4510 PRINT 4520 PRINT "THE ONLY DIFFERENCE BETWEEN THIS GAME AND THE" 4530 PRINT "POPULAR HOME GAME IS THAT YOU MAY GET MULTIPLE" 4540 PRINT "YAHTZEES HERE ..... THE FIRST YAHTZEE SCORES" 4550 PRINT "50 POINTS, AND EACH ADDITIONAL ONE WILL YIELD" 4560 PRINT "A BONUS OF 100 POINTS (IF THE YAHTZEE IS PUT" 4570 PRINT "INTO THE YAHTZEE BLOCK)..... IN ADDITION YOU" 4580 PRINT "WILL BE GIVEN AN EXTRA TURN AT THE END OF" 4590 PRINT "THE GAME":PRINT :PRINT 4600 PRINT "THE WINNER WILL BE ANNOUNCED AT THE END OF" 4610 PRINT "THE GAME - - BUT I WOULDNT ADVISE ANYONE" 4620 PRINT "TO BE LAST......." 4630 PRINT:PRINT 4640 GOSUB 2090:INPUT "HIT RETURN TO CONTINUE ";Y$:BEEP 4650 RETURN 4660 RETURN 4670 LOCATE 10,10:PRINT "YATZEE.BAS VER 3.2" 4680 LOCATE 12,10:PRINT "27 JUN 79" 4690 LOCATE 14,10:PRINT "DEVELOPED BY" 4700 LOCATE 15,13:PRINT "J.L. HELMS & M.F. PEZOK" 4710 LOCATE,16,13:PRINT "1009 LEYTE RD / 1321 SAIPAN RD" 4720 LOCATE 17,17:PRINT "CORONADO, CA. 92118" 4730 LOCATE 18,15:PRINT "(714) 435-6992 / 437-4659" 4740 PRINTCHR$(11) 4750 RETURN 4760 REM 4770 REM END - SORT WINNER 4780 REM 4790 X= 2:IF N= 1THEN 4870 4800 FOR J= 1TO N- 1 4810 IF K(17,J)> K(17,J+ 1)THEN 4850 4820 K= K(17,J):K(17,J)= K(17,J+ 1):K(17,J+ 1)= K 4830 A$= A$(J):A$(J)= A$(J+ 1):A$(J+ 1)= A$ 4840 X= 1 4850 NEXT J 4860 ON X GOTO 4760,4870 4870 REM 4880 REM PRINT WINNERS STANDINGS 4890 REM 4900 RESTORE 5200 4910 FOR J= 1TO N 4920 LOCATE 25,1:PRINTSTRING$(60," "); 4930 IF J> 1 AND J= N THEN RESTORE 5240 4940 LOCATE 25,1:READ A$ 4950 PRINT A$;" ";A$(J);" "; 4960 TT= 500* (N- J+ 1):IF TT< 1500THEN TT= 1500 4970 FOR T= 1TO TT:NEXT T 4980 NEXT J 4990 LOCATE 25,1:PRINTSTRING$(60," "); 5000 LOCATE 24,1:PRINT "+++ END OF GAME +++"; 5010 FOR T= 1TO 2000:NEXT T 5020 ' 5030 GOSUB 2090:LOCATE 25,1:INPUT "PLAY AGAIN? Y/N ";Y$ 5040 IF LEFT$ (Y$,1)= "Y"THEN GOSUB 5090:GOTO 1110 5050 IF LEFT$ (Y$,1)= CHR$(27) THEN BEEP:GOTO 5070 5060 IF LEFT$ (Y$,1)< > "N"THEN BEEP:GOTO 5030 5070 END 5080 END 5090 REM 5100 REM CLEAR MATRICES 5110 REM 5120 FOR K= 1TO 7 5130 FOR J= 1TO 18 5140 K(J,K)= 0 5150 NEXT J 5160 A$(K)= "" 5170 NEXT K 5180 CLS 5190 RETURN 5200 DATA "+++ THE WINNER +++" 5210 DATA " SECOND PLACE"," THIRD PLACE " 5220 DATA " FOURTH PLACE "," FIFTH PLACE " 5230 DATA " SIXTH PLACE " 5240 DATA " DEAD LAST " 5250 REM 5260 REM ERASE DIE 5270 REM 5280 COLOR 0,7:PRINT"";: 5290 LOCATE 4* J+ 1,50:PRINT" "; 5300 LOCATE 4* J+ 2,50:PRINT" "; 5310 LOCATE 4* J+ 3,50:PRINT" "; 5320 COLOR 7,0 5330 RETURN 5340 REM 5350 REM CHECK IF DONE 5360 REM 5370 X= 0 5380 FOR J= 1TO N 5390 Y= 2 5400 FOR K= 1TO 13 5410 IF K(K,J)= 0THEN Y= 1 5420 NEXT K 5430 K(18,J)= Y 5440 IF Y= 2THEN X= X+ 1 5450 NEXT J 5460 IF X= > N THEN A= 0 5470 RETURN 5480 REM 5490 REM COMPUTER PRIORITIES INFO 5500 REM 5510 GOSUB 6780 5520 RETURN 5530 REM 5540 REM PRINT DIE 5550 REM 5560 COLOR 0,7:LOCATE ,,0 5570 REM 5580 PLAY "L32T200N=TN(DIE);" 5590 ON DIE GOTO 5930,5870,5810,5750,5690,5630 5600 ' 5610 ' SIX 5620 ' 5630 LOCATE 4*J+1,50:PRINT "";CHR$(32);CHR$(2);CHR$(32);CHR$(2);CHR$(32);CHR$(2);CHR$(32); 5640 LOCATE 4*J+2,50:PRINT CHR$(32);CHR$(32);CHR$(32);CHR$(32);CHR$(32);CHR$(32);CHR$(32); 5650 LOCATE 4*J+3,50:PRINT CHR$(32);CHR$(2);CHR$(32);CHR$(2);CHR$(32);CHR$(2);CHR$(32);:GOTO 5960 5660 ' 5670 ' FIVE 5680 ' 5690 LOCATE 4*J+1,50:PRINT "";CHR$(32);CHR$(2);CHR$(32);" ";CHR$(32);CHR$(2);" "; 5700 LOCATE 4*J+2,50:PRINT " ";CHR$(32);" ";CHR$(2);" ";CHR$(32);" "; 5710 LOCATE 4*J+3,50:PRINT " ";CHR$(2);" ";CHR$(32);" ";CHR$(2);" ";:GOTO 5960 5720 ' 5730 ' FOUR 5740 ' 5750 LOCATE 4*J+1,50:PRINT "";" ";CHR$(2);" ";CHR$(32);CHR$(2);" "; 5760 LOCATE 4*J+2,50:PRINT " ";CHR$(32);CHR$(32);CHR$(32); 5770 LOCATE 4*J+3,50:PRINT " ";CHR$(2);" ";CHR$(32);CHR$(2);" ";:GOTO 5960 5780 ' 5790 ' THREE 5800 ' 5810 LOCATE 4*J+1,50:PRINT "";" ";CHR$(2);" "; 5820 LOCATE 4*J+2,50:PRINT " ";CHR$(2);" "; 5830 LOCATE 4*J+3,50:PRINT " ";CHR$(2);" ";:GOTO 5960 5840 ' 5850 ' TWO 5860 ' 5870 LOCATE 4*J+1,50:PRINT "";" ";CHR$(2);" "; 5880 LOCATE 4*J+2,50:PRINT " "; 5890 LOCATE 4*J+3,50:PRINT " ";CHR$(2);" ";:GOTO 5960 5900 ' 5910 ' ONE 5920 ' 5930 LOCATE 4*J+1,50:PRINT "";" "; 5940 LOCATE 4*J+2,50:PRINT " ";CHR$(2);" "; 5950 LOCATE 4*J+3,50:PRINT " ";:GOTO 5960 5960 REM GET OUT 5970 COLOR 7,0 5980 LOCATE 1,1 5990 RETURN 6000 REM 6010 REM COMPUTER OPTION 6020 REM 6030 CC= 0 6040 LOCATE 25,1 6050 PRINT "DO YOU WISH TO PLAY AGAINST ME? Y/N ";:GOSUB 2090 6060 Y$=INKEY$:IF Y$="" THEN 6060 ELSE BEEP 6070 IF Y$= "N"THEN RETURN 6080 IF Y$< > "Y"THEN 6040 6090 CC= 1 6100 RETURN 6110 REM 6120 REM CHECK FOR ACES-SIXES ANY POSITION 6130 REM 6140 X= - 1 6150 FOR J= 0TO 4 6160 IF S(0,J)= I THEN X= J 6170 NEXT J 6180 RETURN 6190 REM 6200 REM TOTAL DICE VALUE 6210 REM 6220 FOR J= 1TO 5 6230 K(I,A)= K(I,A)+ C(J) 6240 NEXT J 6250 RETURN 6260 REM 6270 REM MATRIX INFORMATION 6280 REM 6290 REM C(5) CURRENT DICE 6300 REM K(18,7) SCOREBOARD 6310 REM COLUMNS 1-13 BOARD NUMBER 6320 REM COLUMN 14 BONUS UPPER 6330 REM COLUMN 15 TOTAL UPPER 6340 REM COLUMN 16 TOTAL LOWER 6350 REM COLUMN 17 GRAND TOTAL 6360 REM COLUMN 18 DONE/NOT DONE STATUS 6370 REM ROW 1- 7 PLAYERS SCORE 6380 REM ROW N COMPUTERS SCORE (<7 PLAYERS) 6390 REM 6400 REM F(5) DICE NUMBER TO ROLL AGAIN 6410 REM A$(7) PLAYERS NAMES 6420 REM S(6,5) COMPUTERS DICE LOGIC 6430 REM COLUMN 0 DICE NUMBER BY QTY SEQUENCE 6440 REM COLUMN 1 QTY/POSITION FOR ACES 6450 REM COLUMN 2 QTY/POSITION FOR TWOS 6460 REM COLUMN 3 QTY/POSITION FOR THREES 6470 REM COLUMN 4 QTY/POSITION FOR FOURS 6480 REM COLUMN 5 QTY/POSITION FOR FIVES 6490 REM COLUMN 6 QTY/POSITION FOR SIXES 6500 REM ROW 0 QUANTITY OF DICE 6510 REM ROW 1- 5 POSITION OF DICE IN C(5) 6520 REM 6530 REM SAMPLE S(Y,X) FOR DICE OF 5,2,4,6,4 6540 REM 6550 REM Y/X 0 1 2 3 4 5 6560 REM 0 4 6 5 2 IN QTY/VALUE SEQUENCE 6570 REM 1 NO DIE=1 6580 REM 2 1 2 1 TWO POSITION 2 6590 REM 3 NO DIE=3 6600 REM 4 2 3 5 2 FOURS POSITIONS 3 AND 5 6610 REM 5 1 1 1 FIVE POSITION 1 6620 REM 6 1 4 1 SIX POSITION 4 6630 REM + + 6640 REM + + ++++++++++++++++ SECTION FOR POSITION DATA 6650 REM + +------------------ COLUMN INDICATES QTY 6660 REM +------------------------ INDEX EQUATES TO DIE VALUE 6670 REM 6680 REM M(13) PRIORITY NUMBERS FOR MUST SCORE WHERE VALUE 6690 REM REFERS TO PLAY BOARD NUMBER 6700 REM 6710 REM TO RUN INTERNAL CHECKS SECTION - ENTER A -1 FOR 6720 REM PLAYING BOARD NUMBER OR QTY OF DICE TO ROLL 6730 REM AGAIN - - DATA WILL NOT BE LOST AND SCREEN 6740 REM WILL BE RESET WITH CURRENT DICE SHOWN - - 6750 REM PLAYERS/COMPUTERS SCORE WILL NOT SHOW UNTIL 6760 REM AFTER THEIR TURN 6770 REM 6780 REM COMPUTER PRIORIRIES 6790 RESTORE 6800 6800 DATA 11,9,12,8,1,2,3,4,5,6,10,7,13 6810 FOR Y= 1TO 13:READ M(Y):NEXT :RETURN :RETURN 6820 REM player's board 6830 CLS 6840 PRINT" ERRTHENTHENTHENFNTHENTHENTHENFNTHENTHENTHENFNTHENTHENTHENFNTHENTHENTHENFNTHENTHENTHENOPTION 6850 PRINT"ACES........1CALL...CALL...CALL...CALL...CALL...CALL...CALL1" 6860 PRINT"TWOS........2CALL...CALL...CALL...CALL...CALL...CALL...CALL2" 6870 PRINT"THREES......3CALL...CALL...CALL...CALL...CALL...CALL...CALL3" 6880 PRINT"FOURS.......4CALL...CALL...CALL...CALL...CALL...CALL...CALL4" 6890 PRINT"FIVES.......5CALL...CALL...CALL...CALL...CALL...CALL...CALL5" 6900 PRINT"SIXES.......6CALL...CALL...CALL...CALL...CALL...CALL...CALL6" 6910 PRINT" PSETTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHEN<0xB5!>" 6920 PRINT"TOTAL UPPER..CALL...CALL...CALL...CALL...CALL...CALL...CALL" 6930 PRINT" PSETTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHEN<0xB5!>" 6940 PRINT"3 OF A KIND.7CALL...CALL...CALL...CALL...CALL...CALL...CALL7" 6950 PRINT"4 OF A KIND.8CALL...CALL...CALL...CALL...CALL...CALL...CALL8" 6960 PRINT"FULL HOUSE..9CALL...CALL...CALL...CALL...CALL...CALL...CALL9" 6970 PRINT"SM STRAIGHT.ACALL...CALL...CALL...CALL...CALL...CALL...CALLA" 6980 PRINT"LG STRAIGHT.BCALL...CALL...CALL...CALL...CALL...CALL...CALLB" 6990 PRINT"YATZEE......CCALL...CALL...CALL...CALL...CALL...CALL...CALLC" 7000 PRINT"CHANCE......DCALL...CALL...CALL...CALL...CALL...CALL...CALLD" 7010 PRINT" PSETTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHENINSTRTHENTHENTHEN<0xB5!>" 7020 PRINT"TOTAL LOWER..CALL...CALL...CALL...CALL...CALL...CALL...CALL" 7030 PRINT"TOP BONUS....CALL...CALL...CALL...CALL...CALL...CALL...CALL" 7040 PRINT"GRAND TOTAL..CALL...CALL...CALL...CALL...CALL...CALL...CALL" 7050 PRINT" ERLTHENTHENTHENSTEPTHENTHENTHENSTEPTHENTHENTHENSTEPTHENTHENTHENSTEPTHENTHENTHENSTEPTHENTHENTHENSAVE" 7060 FOR N=1 TO 5:LOCATE N*4-2,46:PRINT N;:NEXT 7070 RETURN 7080 LOCATE 25,1:PRINTSTRING$(70," ");:LOCATE 25,1:RETURN 7090 ' KB INPUT AND ESCAPE 7100 KB$="":WHILE KB$="":KB$=INKEY$:WEND 7110 IF KB$=CHR$(27) THEN 5070 ELSE RETURN